home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel-075.lha / feel0.75 / Src / el_linkins.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-06-19  |  3.4 KB  |  165 lines
  1. /* ******************************************************************** */
  2. /* init_elvira.c     Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Interpreter elvira.                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, August 1990
  10.  */
  11.  
  12. /* No Elvira as yet... */
  13.  
  14. #include <irun.h>
  15. #include "allocate.h"
  16. #include "garbage.h"
  17.  
  18. #define FRAMEBUG(x) 
  19.  
  20. LispObject dlp,dp;
  21.  
  22. LispObject elvira_slowcall_object;
  23.  
  24. LispObject Slowcall(LispObject *stacktop)
  25. {
  26.   LispObject res;
  27.  
  28.   if (elvira_slowcall_object == nil)
  29.     CallError(stacktop,"slowcall: object to call unknown",nil,NONCONTINUABLE);
  30.  
  31.   res = module_mv_apply_1(stacktop);
  32.   elvira_slowcall_object = NULL;
  33.  
  34.   return(res);
  35. }
  36.  
  37. /* Copy the current display onto the heap if necessary */
  38.  
  39. void transfer_display_to_heap(LispObject *stacktop)
  40. {
  41.   if (dp != nil) {
  42.  
  43.     if (FRAME_TYPE(dp) == nil) {    /* Copy it to the heap */
  44.       LispObject temp;
  45.       int i;
  46.  
  47.       STACK(dp);
  48.       temp = (LispObject) allocate_vector(stacktop,dp->VECTOR.length);
  49.       UNSTACK(1);
  50.  
  51.       for (i = dp->VECTOR.length-1; i > 0; --i) 
  52.     VREF(temp,i) = VREF(dp,i);
  53.  
  54.       VREF(temp,0) = lisptrue; /* Heap frame */
  55.  
  56.       dlp = dp = temp;
  57.     }
  58.  
  59.   }
  60. }
  61.  
  62. LispObject allocate_e_function(LispObject *stacktop,
  63.            LispObject mod,LispObject (*fun)(LispObject*),int args)
  64. {
  65.   LispObject f;
  66. #if 0
  67. FRAMEBUG(printf("Grabbing function object %d\n",args); fflush(stdout);)
  68.  
  69.   f = allocate_module_function(stacktop,mod,nil,fun,args);
  70.   lval_typeof(f) = TYPE_E_FUNCTION;
  71.  
  72.   STACK_TMP(f);
  73.   transfer_display_to_heap(stacktop);
  74.   UNSTACK_TMP(f);
  75.   
  76.   f->C_FUNCTION.env = (Env) dp; /* Right? */
  77.  
  78. FRAMEBUG(printf("Grabbed function object %d\n",args); fflush(stdout);)
  79. #endif
  80.   return(f);
  81. }
  82.  
  83. /****** THIS CANNOT POSSIBLY WORK ********/
  84. void init_stack_frame(LispObject frame,int n)
  85. {
  86.   int i;
  87.  
  88. FRAMEBUG(printf("Initialising stack frame %d\n",n); fflush(stdout);)
  89.  
  90.   lval_typeof(frame) = TYPE_VECTOR;
  91.   gcof(frame) = -1;
  92.   lval_classof(frame) = Vector;
  93.  
  94.   frame->VECTOR.length = n+2;
  95.  
  96.   FRAME_TYPE(frame) = nil; /* Stack frame */
  97.   LAST_FRAME(frame) = nil;
  98.  
  99.   for (i=0; i<n; ++i) VREF(frame,i+2) = nil;
  100.  
  101. FRAMEBUG(printf("Initialised stack frame %d\n",n); fflush(stdout);)
  102. }
  103.   
  104. LispObject allocate_e_macro(LispObject *stacktop,
  105.                 LispObject mod,
  106.                 LispObject (*fun)(LispObject*),int args)
  107. {
  108.   LispObject f;
  109. #if 0
  110.   f = allocate_module_function(stacktop,mod,nil,fun,args);
  111.   
  112.   lval_typeof(f) = TYPE_E_MACRO;
  113.   f->C_FUNCTION.env = (Env) dp; /* Right? */
  114. #endif
  115.   return(f);
  116. }
  117.  
  118. LispObject *dynamic_ref(LispObject name)
  119. {
  120.   Env ee = DYNAMIC_ENV();
  121.  
  122.   while (ee != NULL)
  123.     if (ee->variable == name) 
  124.       return(&(ee->value));
  125.     else
  126.       ee = ee->next;
  127.  
  128.   if (name->SYMBOL.gvalue != NULL) 
  129.     return(&(name->SYMBOL.gvalue));
  130.   else
  131.     CallError("dynamic: name unbound",name,NONCONTINUABLE);
  132.  
  133.   return(&nil);
  134. }
  135.  
  136. LispObject dynamic_setq(LispObject name,LispObject value)
  137. {
  138.   Env ee = DYNAMIC_ENV();
  139.  
  140.   while (ee != NULL)
  141.     if (ee->variable == name) 
  142.       return(ee->value = value);
  143.     else
  144.       ee = ee->next;
  145.  
  146.   if (name->SYMBOL.gvalue != NULL) 
  147.     return(name->SYMBOL.gvalue = value);
  148.   else
  149.     CallError("dynamic-setq: name unbound",name,NONCONTINUABLE);
  150.  
  151.   return(nil);
  152. }
  153.       
  154. /*
  155. void initialise_elvira_modules(LispObject *stacktop) 
  156. {
  157.   dp = nil;
  158.  
  159.   ELVIRA_INIT_CALL();
  160. }
  161. */
  162.  
  163.  
  164.  
  165.